home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / mpfeel.lha / MPFeel / semaphores.c < prev    next >
C/C++ Source or Header  |  1992-10-06  |  5KB  |  229 lines
  1. /* ******************************************************************** */
  2. /* semaphores.c      Copyright (C) Codemist and University of Bath 1989 */
  3. /*                                                                      */
  4. /* Lisp semaphores                                               */
  5. /* ******************************************************************** */
  6.  
  7. /*
  8.  * $Id: semaphores.c,v 1.5 1992/01/29 13:46:17 pab Exp $
  9.  *
  10.  * $Log: semaphores.c,v $
  11.  * Revision 1.5  1992/01/29  13:46:17  pab
  12.  * sysV fixes
  13.  *
  14.  * Revision 1.4  1992/01/09  22:29:01  pab
  15.  * Fixed for low tag ints
  16.  *
  17.  * Revision 1.3  1992/01/05  22:48:18  pab
  18.  * Minor bug fixes, plus BSD version
  19.  *
  20.  * Revision 1.2  1991/09/11  12:07:34  pab
  21.  * 11/9/91 First Alpha release of modified system
  22.  *
  23.  * Revision 1.1  1991/08/12  16:49:55  pab
  24.  * Initial revision
  25.  *
  26.  * Revision 1.4  1991/03/27  18:25:06  kjp
  27.  * Changes + arg parity correction.
  28.  *
  29.  * Revision 1.3  1991/02/13  18:24:43  kjp
  30.  * Pass.
  31.  *
  32.  */
  33.  
  34. /*
  35.  * Change Log:
  36.  *   Version 1, April 1990
  37.  */
  38.  
  39. #include "defs.h"
  40. #include "structs.h"
  41. #include "funcalls.h"
  42. #include "error.h"
  43.  
  44. #include "global.h"
  45.  
  46. #include "calls.h"
  47. #include "modboot.h"
  48. #include "allocate.h"
  49. #include "modules.h"
  50. #include "threads.h"
  51.  
  52. /* Predicate... */
  53.  
  54. EUFUN_1( Fn_semaphorep, obj)
  55. {
  56.  
  57.   return((is_semaphore(obj)?lisptrue:nil));
  58.  
  59. }
  60. EUFUN_CLOSE
  61.  
  62. #ifndef MACHINE_ANY
  63.  
  64. /* Generator... */
  65.  
  66. EUFUN_0( Fn_make_semaphore)
  67. {
  68.   LispObject retval;
  69.  
  70.   retval = allocate_semaphore(stacktop);
  71.  
  72.   system_initialise_semaphore(&(retval->SEMAPHORE.semaphore));
  73.  
  74.   return(retval);
  75.  
  76. }
  77. EUFUN_CLOSE
  78.  
  79. /* Initialiser... */
  80.  
  81. EUFUN_1( Fn_initialize_semaphore, sem)
  82. {
  83.  
  84.   if (!is_semaphore(sem))
  85.     CallError(stacktop,
  86.           "initialize-semaphore: non semaphore",sem,NONCONTINUABLE);
  87.  
  88.   /* System specific call... */
  89.  
  90.   system_initialise_semaphore(&(sem->SEMAPHORE.semaphore));
  91.  
  92.   /* Trusting OK... */
  93.  
  94.   return(sem);
  95.  
  96. }
  97. EUFUN_CLOSE
  98.  
  99. /* Opener... */
  100.  
  101. EUFUN_1( Fn_open_semaphore, sem)
  102. {
  103.  
  104.   if (!is_semaphore(sem))
  105.     CallError(stacktop,"open-semaphore: non semaphore",sem,NONCONTINUABLE);
  106.  
  107.   /* System specific call... */
  108.  
  109.   while (!system_maybe_open_semaphore(stacktop,&(ARG_0(stackbase)->SEMAPHORE.semaphore)))
  110.     EUCALL_0(Fn_thread_reschedule);
  111.  
  112.   /* Got it... */
  113.  
  114.   return(ARG_0(stackbase));
  115.  
  116. }
  117. EUFUN_CLOSE
  118.  
  119. /* Closer... */
  120.  
  121. EUFUN_1( Fn_close_semaphore, sem)
  122. {
  123.  
  124.   if (!is_semaphore(sem))
  125.     CallError(stacktop,"close-semaphore: non semaphore",sem,NONCONTINUABLE);
  126.  
  127.   /* Syspec.. */
  128.  
  129.   system_close_semaphore(&(sem->SEMAPHORE.semaphore));
  130.  
  131.   return(sem);
  132.  
  133. }
  134. EUFUN_CLOSE
  135.  
  136. #include "threads.h"
  137.  
  138. static SYSTEM_GLOBAL(SystemSemaphore,test_sem);
  139. static SYSTEM_GLOBAL(int,test_sum);
  140. static SYSTEM_GLOBAL(int,test_total);
  141.  
  142. static LispObject runner(LispObject *stacktop)
  143. {
  144.   int n;
  145.  
  146.   for (n=0; n<SYSTEM_GLOBAL_VALUE(test_total); ++n) {
  147.     system_open_semaphore(stacktop,&SYSTEM_GLOBAL_VALUE(test_sem));
  148.     ++SYSTEM_GLOBAL_VALUE(test_sum);
  149.     system_close_semaphore(&SYSTEM_GLOBAL_VALUE(test_sem));
  150.   }
  151.  
  152.   return(nil);
  153. }
  154.  
  155. EUFUN_2( Fn_test_internal_semaphore, threads, count)
  156. {
  157.   LispObject th[100];
  158.   int cthreads,i;
  159.  
  160.   cthreads = intval(threads);
  161.  
  162.   SYSTEM_GLOBAL_VALUE(test_total) = intval(count);
  163.   SYSTEM_GLOBAL_VALUE(test_sum) = 0;
  164.  
  165.   for (i=0; i<cthreads; ++i) {
  166.     LispObject xx;
  167.     xx = (LispObject)
  168.       allocate_module_function(stacktop,
  169.                    (LispObject)NULL,(LispObject)NULL,runner,0);
  170.     EUCALLSET_2(th[i], Fn_make_thread, xx, nil);
  171.     EUCALL_2(Fn_thread_start,th[i],nil);
  172.   }
  173.  
  174.   for (i=0; i<cthreads; ++i) {
  175.     EUCALL_1(Fn_thread_value,th[i]);
  176.   }
  177.  
  178.   return(allocate_integer(stacktop,SYSTEM_GLOBAL_VALUE(test_sum)));
  179. }
  180. EUFUN_CLOSE
  181.  
  182. #endif
  183.   
  184. /* *************************************************************** */
  185. /* Initialisation of this section                                  */
  186. /* *************************************************************** */
  187.  
  188. #ifndef MACHINE_ANY
  189. #define SEMAPHORES_ENTRIES 6
  190. #else
  191. #define SEMAPHORES_ENTRIES 1
  192. #endif
  193.  
  194. MODULE Module_semaphores;
  195. LispObject Module_semaphores_values[SEMAPHORES_ENTRIES];
  196.  
  197. void initialise_semaphores(LispObject *stacktop)
  198. {
  199.  
  200.   open_module(stacktop,
  201.           &Module_semaphores,
  202.           Module_semaphores_values,"semaphores",SEMAPHORES_ENTRIES);
  203.  
  204.   (void) make_module_function(stacktop,"semaphorep",Fn_semaphorep,1);
  205.  
  206. #ifndef MACHINE_ANY
  207.  
  208.   (void) make_module_function(stacktop,"make-semaphore",Fn_make_semaphore,0);
  209.   (void) make_module_function(stacktop,"initialize-semaphore",
  210.                   Fn_initialize_semaphore,1);
  211.   (void) make_module_function(stacktop,"open-semaphore",Fn_open_semaphore,1);
  212.   (void) make_module_function(stacktop,"close-semaphore",Fn_close_semaphore,1);
  213.  
  214.   SYSTEM_INITIALISE_GLOBAL(SystemSemaphore,test_sem,NULL);
  215.   SYSTEM_INITIALISE_GLOBAL(int,test_sum,0);
  216.   SYSTEM_INITIALISE_GLOBAL(int,test_total,0);
  217.  
  218.   system_allocate_semaphore(&SYSTEM_GLOBAL_VALUE(test_sem));
  219.  
  220.   (void) make_module_function(stacktop,"test-internal-semaphores",
  221.                   Fn_test_internal_semaphore,2);
  222.  
  223. #endif
  224.  
  225.   close_module();
  226.  
  227. }
  228.  
  229.